home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-06-30 | 10.7 KB | 252 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- FoldElems
- Syntax10.Scn.Fnt
- (*----------------------------------------------------------------------
- Folds allows the compilation of folded texts automatically inserting error elements at the
- error positions.
- Folds.Compile (^ | * | {filename} ~)
- compiles the specified text(s). If the text contains folds, they are silently unfolded
- before the compilation. Error elements are inserted at the error positions. They can
- be searched for with Folds.ShowError. Old error elements are removed before every
- new compilation and are not stored with Edit.Store. When called from the menu bar,
- Folds.Compile compiles the text in the viewer to which the menu belongs.
- Folds.ShowError
- Sets the caret to the next error element after the previous caret position and displays
- an error message in the Log Viewer. If there is no caret set, ShowError shows the
- first error in the text. If an error element is contained in a folded text part, the fold
- is automatically expanded. ShowError expects a table of error numbers and error
- messages in a specific file (OberonErrors.Text for default).
- Folds.Restore *
- Collapses all folds that were unfolded during Folds.ShowErrors in the marked viewer.
- Folds.SetProfile
- A couple of settings are stored in the file Folds.Profile which is read when module Folds
- is loaded. When these settings are changed in Folds.Profile they can be reloaded with
- the command Folds.SetProfile. The default contents of Folds.Profile (which are also the
- default settings when Folds.Profile is missing) are as follows:
- compiler = Compiler.Compile /s
- errorFile = OberonErrors.Text
- showWarnings = yes
- The settings allow to select a different compiler, different default compilation options,
- and a different error message file. They also specify if error elements should be inserted for
- warnings.
- ----------------------------------------------------------------------*)
- Syntax10i.Scn.Fnt
- StampElems
- Alloc
- 30 Jun 95
- Syntax10b.Scn.Fnt
- Syntax10.Scn.Fnt
- Documentation
- MODULE Folds; (* HM
- IMPORT
- Display, Input, Files, Fonts, Oberon, Texts, Viewers, TextFrames, MenuViewers, FoldElems;
- CONST
- profile = "Folds.Profile";
- unit = LONG(TextFrames.Unit);
- left = 2; middle = 1; right = 0;
- CR = 0DX;
- ErrElem = POINTER TO ErrElemDesc;
- ErrElemDesc = RECORD(Texts.ElemDesc)
- err: INTEGER
- END;
- Options = ARRAY 16 OF CHAR;
- w: Texts.Writer;
- errT: Texts.Text;
- compName, errFile: ARRAY 24 OF CHAR;
- globOpt: Options;
- showWarnings: BOOLEAN;
- errors: INTEGER;
- PROCEDURE *NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT);
- END NoNotify;
- PROCEDURE *ErrCheck (e: Texts.Elem): BOOLEAN;
- BEGIN RETURN e IS ErrElem
- END ErrCheck;
- PROCEDURE GetOptions (VAR s: Texts.Scanner; VAR opt: ARRAY OF CHAR);
- VAR i: INTEGER;
- BEGIN i := 0;
- WHILE s.nextCh = " " DO Texts.Read(s, s.nextCh) END;
- IF (s.nextCh = "/") OR (s.nextCh = "\") THEN
- REPEAT opt[i] := s.nextCh; INC(i); Texts.Read(s, s.nextCh) UNTIL (CAP(s.nextCh) < "A") OR (CAP(s.nextCh) > "Z")
- END;
- opt[i] := 0X
- END GetOptions;
- PROCEDURE MarkedFrame (): TextFrames.Frame;
- VAR v: Viewers.Viewer; x: LONGINT;
- BEGIN v := Oberon.MarkedViewer();
- IF (v # NIL ) & (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN RETURN v.dsc.next(TextFrames.Frame)
- ELSE RETURN NIL
- END MarkedFrame;
- PROCEDURE OpenTempViewer (t: Texts.Text; VAR v: MenuViewers.Viewer);
- VAR x, y, h: INTEGER;
- BEGIN y := Display.Bottom; x := Display.Width-1; h := Viewers.minH; Viewers.minH := 1;
- v := MenuViewers.New(TextFrames.NewMenu("", ""),
- TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
- Oberon.Pointer.X := x; Oberon.Pointer.Y := y;
- Viewers.minH := h
- END OpenTempViewer;
- PROCEDURE Show (f: TextFrames.Frame; pos: LONGINT);
- VAR end, delta: LONGINT;
- BEGIN delta := 200;
- LOOP end := TextFrames.Pos(f, f.X + f.W, f.Y);
- IF (f.org <= pos) & (pos < end) OR (f.org = end) THEN EXIT END;
- TextFrames.Show(f, pos - delta); DEC(delta, 20)
- END Show;
- PROCEDURE *HandleErr (E: Texts.Elem; VAR msg: Texts.ElemMsg);
- VAR e: ErrElem; x, y, w, h: INTEGER; keys: SET;
- BEGIN
- WITH E: ErrElem DO
- WITH
- msg: TextFrames.DisplayMsg DO
- IF ~msg.prepare THEN
- w := SHORT(E.W DIV unit); h := SHORT(E.H DIV unit);
- Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 1, w - 2, h-2, Display.replace)
- END
- | msg: TextFrames.TrackMsg DO
- IF msg.keys = {middle} THEN
- REPEAT
- Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
- UNTIL keys = {}
- END
- | msg: Texts.CopyMsg DO
- NEW(e); Texts.CopyElem(E, e); e.err := E.err; msg.e := e
- ELSE (*ignore it*)
- END
- END HandleErr;
- PROCEDURE InsertErrElems (F: TextFrames.Frame; t: Texts.Text; pos: LONGINT);
- VAR S: Texts.Scanner; err: INTEGER; e: ErrElem;
- BEGIN errors := 0;
- Texts.OpenScanner(S, Oberon.Log, pos); Texts.Scan(S);
- LOOP S.line := 0;
- IF S.eot THEN EXIT
- ELSIF (S.class = Texts.Name) & (S.s = "pos") THEN Texts.Scan(S);
- IF S.class = Texts.Int THEN pos := S.i ELSE EXIT END ;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.class = Texts.Int);
- IF S.eot THEN EXIT
- ELSIF showWarnings OR (S.i < 300) OR (S.i > 399) THEN
- NEW(e); e.W := Fonts.Default.height * unit; e.H := e.W;
- e.handle := HandleErr; e.err := SHORT(S.i);
- Texts.WriteElem(w, e); Texts.Insert(t, pos + errors, w.buf);
- INC(errors)
- END
- END ;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
- END InsertErrElems;
- PROCEDURE DeleteErrElems (t: Texts.Text);
- VAR r: Texts.Reader; pos: LONGINT;
- BEGIN Texts.OpenReader(r, t, 0);
- LOOP Texts.ReadElem(r);
- IF r.elem = NIL THEN EXIT
- ELSIF r.elem IS ErrElem THEN
- pos := Texts.Pos(r); Texts.Delete(t, pos-1, pos); Texts.OpenReader(r, t, pos-1)
- END
- END DeleteErrElems;
- (*PROCEDURE ErrVisible (f: TextFrames.Frame): BOOLEAN;
- VAR end: LONGINT; r: Texts.Reader; e: Texts.Elem;
- BEGIN end := TextFrames.Pos(f, f.X + f.W, f.Y);
- IF end + 1 = f.text.len THEN INC(end) END;
- -- ErrorElem inserted at f.text.len causes Pos to return the wrong position *)
- Texts.OpenReader(r, f.text, f.org);
- LOOP Texts.ReadElem(r);
- IF (r.elem = NIL) OR (Texts.Pos(r) > end) THEN RETURN FALSE
- ELSIF r.elem IS ErrElem THEN RETURN TRUE
- END
- END ErrVisible;
- PROCEDURE GetErrMsg (err: INTEGER; VAR msg: ARRAY OF CHAR);
- VAR s: Texts.Scanner; n: INTEGER; ch: CHAR;
- BEGIN Texts.OpenScanner(s, errT, 0);
- REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.Int) & (s.i = 0);
- WHILE ~ s.eot & ((s.class # Texts.Int) OR (s.i # err)) DO Texts.Scan(s) END;
- IF ~s.eot THEN Texts.Read(s, ch); n := 0;
- WHILE ~s.eot & (ch # CR) DO msg[n] := ch; INC(n); Texts.Read(s, ch) END;
- msg[n] := 0X
- END GetErrMsg;
- PROCEDURE SetProfile*;
- VAR s: Texts.Scanner; t: Texts.Text; f: Files.File;
- BEGIN
- compName := "Compiler.Compile"; errFile := "OberonErrors.Text"; globOpt := ""; showWarnings := TRUE;
- f := Files.Old(profile);
- IF f # NIL THEN NEW(t); Texts.Open(t, profile); Texts.OpenScanner(s, t, 0); Texts.Scan(s);
- WHILE ~ s.eot DO
- IF s.class = Texts.Name THEN
- IF s.s = "compiler" THEN
- Texts.Scan(s); Texts.Scan(s); COPY(s.s, compName);
- GetOptions(s, globOpt)
- ELSIF s.s = "errorFile" THEN
- Texts.Scan(s); Texts.Scan(s); COPY(s.s, errFile)
- ELSIF s.s = "showWarnings" THEN
- Texts.Scan(s); Texts.Scan(s);
- showWarnings := s.s = "yes"
- END
- END;
- Texts.Scan(s)
- END
- END;
- errT := TextFrames.Text(errFile)
- END SetProfile;
- PROCEDURE Compile*;
- VAR f: TextFrames.Frame; t: Texts.Text; res: INTEGER; s: Texts.Scanner;
- beg, end, time, pos: LONGINT; v: MenuViewers.Viewer; oldNotify: Texts.Notifier; par: Oberon.ParList;
- ready: BOOLEAN; opt: Options;
- BEGIN
- par := Oberon.Par;
- Texts.OpenScanner(s, par.text, par.pos);
- REPEAT Texts.Scan(s); t := NIL; f := NIL; ready := FALSE;
- IF par.vwr.dsc = par.frame THEN
- f := par.frame.next(TextFrames.Frame);
- Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, f.X, f.Y);
- Oberon.FadeCursor(Oberon.Pointer);
- t := f.text; opt := globOpt; ready := TRUE
- ELSE
- IF s.class = Texts.Name THEN t := TextFrames.Text(s.s)
- ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
- f := MarkedFrame(); IF f # NIL THEN t := f.text END;
- ready := TRUE
- ELSIF (s.class = Texts.Char) & (s.c = "^") THEN
- Oberon.GetSelection(t, beg, end, time);
- IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s);
- IF s.class = Texts.Name THEN t := TextFrames.Text(s.s) END
- END
- END;
- GetOptions(s, opt)
- END;
- IF t # NIL THEN
- DeleteErrElems(t);
- oldNotify := t.notify; t.notify := NoNotify;
- FoldElems.ExpandAll(t, 0, TRUE);
- IF f = NIL THEN OpenTempViewer(t, v) ELSE DeleteErrElems(t) END;
- par.text := TextFrames.Text(""); Texts.Write(w, "*"); Texts.WriteString(w, opt);
- Texts.Append(par.text, w.buf); par.pos := 0; pos := Oberon.Log.len;
- Oberon.Call(compName, par, FALSE, res);
- IF (res = 0) & (f # NIL) THEN InsertErrElems(f, t, pos) END;
- FoldElems.CollapseAll(t, {FoldElems.tempLeft});
- IF f = NIL THEN
- Viewers.Close(v)
- ELSE
- t.notify := oldNotify;
- IF errors # 0 THEN t.notify(t, Texts.replace, 0, t.len) END
- END
- END
- UNTIL (t = NIL) OR ready
- END Compile;
- PROCEDURE ShowError*;
- VAR F: Display.Frame; pos: LONGINT; e: Texts.Elem; msg: ARRAY 128 OF CHAR;
- BEGIN
- IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN F := Oberon.Par.frame.next
- ELSE F := Oberon.FocusViewer.dsc.next
- END;
- WITH F: TextFrames.Frame DO
- IF F.hasCar THEN pos := F.carloc.pos ELSE pos := 0 END;
- FoldElems.FindElem(F.text, pos, ErrCheck, e);
- IF e # NIL THEN pos := Texts.ElemPos(e);
- Show(F, pos);
- Oberon.PassFocus(Viewers.This(F.X, F.Y));
- TextFrames.SetCaret(F, pos + 1);
- GetErrMsg(e(ErrElem).err, msg);
- Texts.WriteString(w, msg); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
- END
- ELSE
- END ShowError;
- BEGIN
- Texts.OpenWriter(w); SetProfile
- END Folds.
-